home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 22
/
Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso
/
Aminet
/
game
/
patch
/
PFLaunch.lha
/
Pinball.e
< prev
next >
Wrap
Text File
|
1997-08-29
|
9KB
|
268 lines
-> $VER: Pinball Fantasies AGA launcher source (28.8.97)
/*
Sneaky space-saving constructs
I'm using two constants MEMSIZE and NVBLOCK, which are precalculated
calculations with the constant HSLEN (they are HSLEN+10 and HSLEN/10+1,
respectively)
Why generate code to manipulate constants?!
Uses '\s by Digital Illusions',[title] where title is 'Pinball Fantasies AGA'
to save writing it twice!
Uses raw menupick values instead of pulling them out with (code generating)
macros. But why are the values $FFFFxxxx ? Well, because msg.code is an INT,
when I write code:=msg.code, E extracts the INT and sign-extends it to a
LONG. As bit 15 is always set (NOSUBMENU), it's always considered negative.
I could write code:=code AND $FFFF but that's more code for nothing! :)
*/
OPT OSVERSION=39
MODULE 'exec/memory', 'exec/nodes', 'exec/ports',
'gadtools', 'libraries/gadtools',
'graphics/rastport', 'graphics/text',
'intuition/intuition', 'intuition/screens',
'lowlevel',
'nonvolatile',
'utility/tagitem'
CONST HSLEN=256,MEMSIZE=266,NVBLOCKS=26
OBJECT table
name, dir, file, hs_off
ENDOBJECT
DEF wnd:PTR TO window, scr:PTR TO screen, tables:PTR TO table, title, hs
PROC main()
tables:=['Party Land', 'PF2:', 'pinfilea.dat', 0,
'Speed Devils', 'PF1:', 'pinfileb.dat', 48,
'Million Dollar Gameshow', 'PF3:', 'pinfilec.dat', 128,
'Stones ''n'' Bones', 'PF4:', 'pinfiled.dat', 176]:table
title:='Pinball Fantasies AGA'
SetChipRev(-1)
IF gadtoolsbase:=OpenLibrary('gadtools.library',39)
IF nvbase:=OpenLibrary('nonvolatile.library',39)
IF lowlevelbase:=OpenLibrary('lowlevel.library',39)
IF hs:=AllocVec(MEMSIZE,MEMF_CLEAR)
IF scr:=LockPubScreen(NIL)
createwindow()
UnlockPubScreen(NIL,scr)
ENDIF
FreeVec(hs)
ENDIF
CloseLibrary(lowlevelbase)
ENDIF
CloseLibrary(nvbase)
ENDIF
CloseLibrary(gadtoolsbase)
ENDIF
ENDPROC
PROC createwindow()
DEF font:PTR TO textfont, gad:PTR TO gadget, rp:PTR TO rastport,
gadlist, visinf, menus, n,
gad_w, gad_h, off_x, off_y, wnd_w, wnd_h
-> font sensitive gadget layout calculations
rp:=scr.rastport
font:=rp.font
off_x:=scr.wborleft -> left border offset
off_y:=rp.txheight+scr.wbortop+1 -> top border offset
-> calculate generic gadget width from the longest of the buttons
gad_w:=0
FOR n:=0 TO 3 DO gad_w:=Max(gad_w,TextLength(rp,tables[n].name,StrLen(tables[n].name))+32)
gad_h:=font.ysize+6
-> window width and height
wnd_w:=Max(off_x + gad_w + 4 + scr.wborright,
off_y*2 + TextLength(rp,title,StrLen(title)))
wnd_h:=gad_h+1*4+off_y+1+scr.wborbottom
IF visinf:=GetVisualInfoA(scr,[TAG_DONE])
IF gad:=CreateContext({gadlist})
FOR n:=0 TO 3
gad:=CreateGadgetA(BUTTON_KIND,gad,
[off_x+2, -> left edge
gad_h+1*n+off_y+1, -> top edge
gad_w, gad_h, -> width, height
tables[n].name, -> name
[font.mn.ln.name,font.ysize,0,0]:textattr, -> font
n, -> gadgetID
16,visinf,0]:newgadget,NIL)
ENDFOR
IF menus:=CreateMenusA(
[NM_TITLE, 0,'Project', NIL, 0,0,0,
NM_ITEM, 0,'About...', '?', 0,0,0,
NM_ITEM, 0,NM_BARLABEL, NIL, 0,0,0,
NM_ITEM, 0,'Quit', 'Q', 0,0,0,
NM_END, 0,NIL, NIL, 0,0,0]:newmenu,0)
IF LayoutMenusA(menus,visinf,[GTMN_NEWLOOKMENUS,TRUE,TAG_DONE])
IF wnd:=OpenWindowTagList(NIL,
[WA_LEFT, (scr.width-wnd_w)/2,
WA_TOP, (scr.height-wnd_h)/2,
WA_WIDTH, wnd_w,
WA_HEIGHT, wnd_h,
WA_IDCMP, IDCMP_REFRESHWINDOW OR
IDCMP_VANILLAKEY OR
IDCMP_GADGETUP OR
IDCMP_CLOSEWINDOW OR
IDCMP_MENUPICK,
WA_FLAGS, WFLG_ACTIVATE OR
WFLG_DRAGBAR OR
WFLG_CLOSEGADGET OR
WFLG_DEPTHGADGET OR
WFLG_NEWLOOKMENUS,
WA_TITLE, title,
WA_GADGETS, gadlist,
WA_PUBSCREEN, scr,
WA_SCREENTITLE, 'PFLaunch by Kyzer/CSG <kyzer@4u.net>',
WA_AUTOADJUST, TRUE,
TAG_DONE])
IF SetMenuStrip(wnd,menus)
Gt_RefreshWindow(wnd,NIL)
handlewindow()
ClearMenuStrip(wnd)
ENDIF
CloseWindow(wnd)
ENDIF
ENDIF
FreeMenus(menus)
ENDIF
FreeGadgets(gadlist)
ENDIF
FreeVisualInfo(visinf)
ENDIF
ENDPROC
PROC handlewindow()
DEF iaddr:PTR TO gadget, msg:PTR TO intuimessage, code, class, quitflag=0
REPEAT
WaitPort(wnd.userport) -> might as well wait for a message first
WHILE msg:=Gt_GetIMsg(wnd.userport)
class:=msg.class -> copy info from msg then reply it immediately
code:=msg.code
iaddr:=msg.iaddress
Gt_ReplyIMsg(msg)
SELECT class
CASE IDCMP_REFRESHWINDOW -> refresh window
Gt_BeginRefresh(wnd)
Gt_EndRefresh(wnd,TRUE)
CASE IDCMP_CLOSEWINDOW -> closegadget pressed
quitflag:=TRUE
CASE IDCMP_VANILLAKEY -> key pressed, code=key
IF (code>="1") AND (code<="4") THEN play(code-"1")
IF (code="Q") OR (code="q") OR (code="\e") THEN quitflag:=TRUE
CASE IDCMP_GADGETUP -> gadget pressed then released
play(iaddr.gadgetid)
CASE IDCMP_MENUPICK -> menu item chosen
SELECT code
CASE $FFFFF800 -> 'About...'
request('\s by Digital Illusions.\n\n'+
'Published by 21st Century Entertainment.',0,[title])
CASE $FFFFF840 -> 'Quit'
quitflag:=TRUE
ENDSELECT
ENDSELECT
ENDWHILE
UNTIL quitflag
ENDPROC
PROC play(lev)
DEF lock, loadseg, nv, olddir, req:requester, gamedata:PTR TO LONG
IF nv:=GetCopyNV('Pinball','Highscore',TRUE)
CopyMem(nv,hs,HSLEN)
FreeNVData(nv)
ELSE
CopyMem({defsc},hs,HSLEN)
ENDIF
InitRequester(req); Request(req,wnd)
SetWindowPointerA(wnd,[WA_BUSYPOINTER,TRUE,TAG_DONE])
IF (loadseg:=LoadSeg(tables[lev].file))=0
IF lock:=Lock(tables[lev].dir,-2)
olddir:=CurrentDir(lock)
loadseg:=LoadSeg(tables[lev].file)
CurrentDir(olddir)
UnLock(lock)
ENDIF
ENDIF
ClearPointer(wnd); EndRequest(req,wnd)
IF loadseg=0
request('Can''t load table',0)
RETURN
ENDIF
Delay(50)
CacheClearU()
-> this is the data that the game code wants
gamedata:=[0,hs+tables[lev].hs_off,hs,dosbase,gfxbase,nvbase,lowlevelbase,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
MOVEM.L D1-D7/A0-A6,-(A7)
MOVE.L gamedata,A1
MOVE.L loadseg,A0 -> loadseg is a BPTR
ADDA.L A0,A0
ADDA.L A0,A0
MOVE.L A1,A5 -> this is OK, even though E warns you about it!
SUBA.L A1,A1
JSR 4(A0)
MOVEM.L (A7)+,D1-D7/A0-A6
TST.L D0
BEQ noscores
REPEAT
IF StoreNV('Pinball','Highscore',hs,NVBLOCKS,FALSE)=0 THEN JUMP noscores
UNTIL request('Can''t save highscores','Retry|Cancel')=0
noscores:
UnLoadSeg(loadseg)
ENDPROC
PROC request(b,r,a=0)
ENDPROC EasyRequestArgs(wnd,[20,0,title,b,IF r THEN r ELSE 'OK'],0,a)
-> The default scores
defsc:
LONG "TSL ",0,$50000000, -> 50,000,000 points (Party Land)
"TSL ",0,$25000000, -> 25,000,000 points (Party Land)
"TSL ",0,$10000000, -> 10,000,000 points (Party Land)
"TSL ",0,$05000000, -> 5,000,000 points (Party Land)
"TSL ",1,$00000000, -> 100,000,000 points (Speed Devils)
"TSL ",0,$50000000, -> 50,000,000 points (Speed Devils)
"TSL ",0,$25000000, -> 25,000,000 points (Speed Devils)
"TSL ",0,$10000000, -> 10,000,000 points (Speed Devils)
" P","ARTY"," LAN","D ",
" SP","EED ","DEVI","LS ",
"TSL ",1,$00000000, -> 100,000,000 points (Billion $ Gameshow)
"TSL ",0,$50000000, -> 50,000,000 points (Billion $ Gameshow)
"TSL ",0,$25000000, -> 25,000,000 points (Billion $ Gameshow)
"TSL ",0,$10000000, -> 10,000,000 points (Billion $ Gameshow)
"TSL ",1,$00000000, -> 100,000,000 points (Stones 'n' Bones)
"TSL ",0,$50000000, -> 50,000,000 points (Stones 'n' Bones)
"TSL ",0,$25000000, -> 25,000,000 points (Stones 'n' Bones)
"TSL ",0,$10000000, -> 10,000,000 points (Stones 'n' Bones)
" BIL","LION"," DOL","LAR ",
" STO","NES ","N BO","NES "
CHAR '\0$VER: PFLaunch 1.1 (28.8.97)\0'